perm filename METER.FAI[XX,LCS] blob
sn#210707 filedate 1976-04-09 generic text, type T, neo UTF8
00100 ;; 24300 SUBROUTINE METER
00200 TITLE METER
00300 ENTRY METER,MAKNUM
00400 EXTERNAL NOZERO,.COMM.,ITMSUB,POSI
00410 EXTERNAL ALPHA,IFIX,STF,AMOD,CENTX,SLUR
00500 METER: 0
00600 ; 25100 CALL NOZERO(R7)
00700 JSA 16,NOZERO
00800 JUMP .COMM.+=8
00900 ; 25200 JZ=J3
01000 MOVE 02,.COMM.+=24
01100 MOVEM 02,JZ#
01200
01300 ; 25300 RY=R4+8.*.COMM.+=8
01400 MOVE 02,.COMM.+=8
01500 FSC 02,3
01600 FADRB 02,.COMM.+5
01700 MOVEM 02,RY#
01800 ; 26300 R4=RY
01900 ; 25400 C HEIGHT
02000 ; 25500 RW=R6
02100 MOVE 02,.COMM.+7
02200 MOVEM 02,RW#
02300 ; 25600 C BOTTOM NUM
02400 ; 25700 C P5=TOP NUM
02500 ; 25800 R6=.COMM.+=8
02600 MOVE 02,.COMM.+=8
02700 MOVEM 02,.COMM.+7
02800 ; 25900 RR6=R6
02900 MOVEM 02,RR6#
03000 ; 26000 C SIZE
03100 ; 26100 C FOR BDR40 -- OR =1
03200 ; 26200 M=0
03300 SETZM M#
03400 ; 26400 2 .COMM.+=8=0
03500 MT2: SETZM .COMM.+=8
03600 ; 26500 C .COMM.+=8=0 FOR BDR FONT??
03700 ; 26600 CC IF(R5.NE.99)GO TO 1
03800 ; 26700 IF(R5.LT.90)GO TO 3
03900 MOVSI 02,207550
04000 CAMLE 02,.COMM.+6
04100 JRST MT3
04200 ; 26800 C 99 AS METER = 'C' 98=ALLA BREVE (CUT TIME)
04300 ; 26900 M=-1
04400 SETOM M
04500 ; 27000 IF(R5.NE.98)GO TO 4
04600 MOVSI 02,207610
04700 CAME 02,.COMM.+6
04800 JRST MT4
04900 ; 27100 C NEXT FOR LINE THROUGH C.
05000 ; 27200 RZ=R6
05100 ;; MOVE 02,.COMM.+7
05200 ;; MOVEM 02,RZ#
05300 ; 27300 RY=R4
05400 ;; MOVE 02,.COMM.+5
05500 ;; MOVEM 02,RY
05600 ; 27400 RA=POS
05700 MOVE 02,POSI+=9
05800 MOVEM 02,RA#
05900 ; 27500 R6=RX3
06000 MOVE 02,.COMM.+=23
06100 MOVEM 02,.COMM.+7
06200 ; 27600 C TO LINE UP WITH R3
06300 ; 27700 J10=2
06400 MOVEI 02,2
06500 MOVEM 02,.COMM.+=31
06600 ; 27800 C FOR THICK LINE
06700 ; 27810 CC R5=9.8+R4
06800 ; 28000 R4=R4-3.8
06900 MOVN 02,[3.8]
07000 FADRB 02,.COMM.+5
07100 ; 28050 R5=R4+5.6
07200 FADR 02,[5.6]
07300 MOVEM 02,.COMM.+6
07400 ; 28100 J7=0
07500 SETZM .COMM.+=28
07600 ; 28200 R8=0
07700 SETZM .COMM.+=9
07800 ; 28300 CALL ITMSUB
07900 JSA 16,ITMSUB
08000 ; 28400 POS=RA
08100 MOVE 02,RA
08200 MOVEM 02,POSI+=9
08300 ; 28500 R4=RY
08400 MOVE 02,RY
08500 MOVEM 02,.COMM.+5
08600 ; 28600 R6=RZ
08700 MOVE 02,RR6
08800 MOVEM 02,.COMM.+7
08900 ; 28700 C GET BACK THE RIGHT PARAMS.
09000 ; 28900 4 R5=9999.
09100 MT4: MOVE 02,[9999.0]
09200 MOVEM 02,.COMM.+6
09300 ; 29100 C TO CENTER 12S AND 16S
09400 ; 29200 3 CALL MAKNUM(R5)
09500 MT3: JSA 16,MAKNUM
09600 JUMP .COMM.+6
09700 ; 29300 IF(M)RETURN
09800 SKIPGE M
09900 JRA 16,(16)
10000 ; 29400 C STICK AROUND FOR BOTTOM NUM
10100 ; 29500 M=-1
10200 SETOM M
10300 ; 29700 R6=RR6
10400 MOVE 02,RR6
10500 MOVEM 02,.COMM.+7
10600 ; 29600 R4=RY-4.*RR6
10700 FSC 02,2
10800 FSBR 02,RY
10900 MOVNM 02,.COMM.+5
11000 ; 29800 R5=RW
11100 MOVE 02,RW#
11200 MOVEM 02,.COMM.+6
11300 ; 29900 C GET BOTTOM NUM
11400 ; 30000 J3=JZ
11500 MOVE 02,JZ
11600 MOVEM 02,.COMM.+=24
11700 ; 30100 R8=0
11800 SETZM .COMM.+=9
11900 ; 30200 GO TO 2
12000 JRST MT2 ;30300 END
12100
12200
12500 MAKNUM: 0 ; SUBROUTINE MAKNUM(RNUM)
12600 ;100 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
12700 ;200 EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
12800 ;300 1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
12900 ;400 1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
13000 ;500 1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
13100 ;600 DATA RS/10.0/,RBX/1.0/
13200 MOVE 11,@(16) ;GET RNUM (KEEP 11 CLEAN IN OTHER ROUTINES)
13400 MOVE 02,.COMM.+=9 ; RB8=R8
13500 MOVEM 02,RB8#
13600 MOVE 02,.COMM.+=24 ; J3X=J3
13700 MOVEM 02,J3X# ; P7=0=BDR40; =1=BDI40; =2=PRIM.
13800 JSA 16,NOZERO ; CALL NOZERO(R6)
13900 JUMP .COMM.+7
14000 MOVE 02,.COMM.+7 ; R5=R6
14100 MOVEM 02,.COMM.+6 ; UPPER CASE - BDR40
14200 MOVSI 02,206620 ; R6=48000000.0+(R7+50.)*10000.
14300 FADR 02,.COMM.+=8
14400 FMPR 02,[10000.0]
14500 FADR 02,[48000000.0]
14600 MOVEM 02,.COMM.+7
14700 MOVE 02,[99999999.0] ; R7=99999999.0
14800 MOVEM 02,.COMM.+=8
14900 ; 32500 C BLANKS
15000 ; 32700 IF(RNUM.NE.9999.)GO TO 2
15100 CAME 11,[9999.0]
15200 JRST MN2
15300 ; 32800 C NEXT FOR 'C'OMMON TIME
15400 ; 32900 RNUM=12.
15500 MOVSI 11,204600
15600 ; 33000 C MAKES A 'C'
15700 ; 33100 R4=R4-2.2
15800 MOVN 02,[2.2]
15900 FADRM 02,.COMM.+5
16000 ; 33200 C .2 FOR BAD POS. OF LETTERS
16100 ; 33300 GO TO 4
16200 JRST MN4
16300 ; 33500 2 ONE=0
16400 MN2: SETZM ONE#
16500 ; 33600 RNUM=IFIX(RNUM)
16600 JSA 16,IFIX
16700 JUMP 11
16800 ;; MOVEM 11
16900 ;; JSA 16,FLOAT
17000 ;; JUMP 11
17005 MOVE 11,0
17010 TLC 11,232000
17020 FADR 11,11
17200 ; 33700 C SO MISTAKES (I.E. 2.2) WON'T BREAK THE PROG.
17300 ; 33800 IF(RNUM.EQ.1.)ONE=3.
17500 CAME 11,[1.0]
17600 JRST .+3
17700 MOVSI 02,202600
17800 MOVEM 02,ONE
17900 ; 33900 IF(RNUM.GT.9.)GO TO 3
18100 CAMLE 11,[9.0]
18200 JRST MN3
18300 ; 34000 C JUMP FOR 2 OR 3 DIGIT NUMBER
18400 ; 34100 4 R6=R6+RNUM*100.+47.
18500 ;;MN4: MOVSI 02,206570
18600 MN4: MOVSI 03,207620
18700 FMPR 03,11
18800 FADR 3,[47.0]
18900 FADRM 3,.COMM.+7
19000 ; 34200 C PUTS BLANK ON END (.47)
19100 ; 34300 GO TO 1
19200 JRST MN1
19300 ; 34500 3 RJY=10.
19400 MN3: MOVSI 3,204500 ; 3 NOW HAS RJY
19500 ;; MOVEM 02,RJY#
19600 CAML 11,[100.0] ; 34600 IF(RNUM.GE.100.)RJY=100.
20000 MOVSI 3,207620
20100 ;; MOVEM 03,RJY#
20200 ; 34700 B=IFIX(RNUM/RJY)
20300 MOVE 02,11
20400 ;; FDVR 02,RJY
20410 FDVR 2,3
20600 JSA 16,IFIX
20700 JUMP 2
20800 ;; MOVEM B
20900 ;; JSA 16,FLOAT
21000 ;; JUMP B#
21010 TLC 0,232000
21020 FADR 0,0
21100 MOVEM B
21200 ; 34800 C=AMOD(RNUM,RJY)
21300 JSA 16,AMOD
21400 JUMP 11
21500 JUMP 3
21600 MOVEM C#
21700 ; 34900 IF(RNUM.LT.100)GO TO 7
21900 CAMGE 11,[100.0]
22000 JRST MN7
22100 ; 35000 D=IFIX(C/10.)
22200 MOVE 02,C
22300 FDVR 02,[10.0]
22500 JSA 16,IFIX
22600 JUMP 2
22700 ;; MOVEM D
22800 ;; JSA 16,FLOAT
22900 ;; JUMP D
22910 TLC 0,232000
22920 FADR 0,0
23000 MOVEM D#
23100 ; 35100 C=AMOD(C,10.)
23200 JSA 16,AMOD
23300 JUMP C
23400 JUMP [10.0]
23500 MOVEM C
23600 ; 35200 IF(C.EQ.1.)ONE=ONE+3.
23800 CAME [1.0]
23900 JRST .+3
24000 MOVSI 02,202600
24100 FADRM 02,ONE
24200 ; 35300 R7=C*1000000.+999999.0
24300 FMPR 0,[1000000.0]
24500 FADR 0,[999999.0]
24600 MOVEM 0,.COMM.+=8
24700 ; 35400 C=D
24800 MOVE 02,D
24900 MOVEM 02,C
25000 ; 35500 7 R6=R6+B*100.+C
25100 ;;MN7: MOVE 02,.COMM.+7
25200 ;; FADR 02,C
25300 MN7: MOVSI 03,207620
25400 FMPR 03,B#
25500 FADR 3,C
25600 FADRM 3,.COMM.+7
25700 ; 35600 IF(B.EQ.1.)ONE=ONE+3.
25800 MOVSI 02,201400
25900 CAME 02,B
26000 JRST .+3
26100 MOVSI 3,202600
26200 FADRM 3,ONE
26300 ; 35700 IF(C.EQ.1.)ONE=ONE+3.
26500 CAME 02,C
26600 JRST .+3
26700 MOVSI 02,202600
26800 FADRM 02,ONE
26900 ; 35800 B=R5
27000 MOVE 02,.COMM.+6
27100 MOVEM 02,B
27200 ; 35900 IF(RNUM.GE.100.)B=B*2
27400 CAMGE 11,[100.0]
27500 JRST .+3
27600 MOVSI 02,202400
27700 FMPRB 02,B
27800 ; 36000 J3=J3-RS*RSTJ2*B
27900 FMPR 02,[10.0]
28000 FMPR 02,STF+=8
28600 JSA 16,IFIX
28700 JUMP 2
28710 SUB 0,.COMM.+=24
28800 MOVNM .COMM.+=24
28900 ; 36100 C FOR 2 DIGIT NUMBER
29000 ; 36600 C ADJUSTS FOR 11, ETC.
29100 ; 36900 1 J3=J3+ONE*R5*RSTJ2
29200 MN1: MOVE 02,.COMM.+6
29300 FMPR 02,ONE
29400 FMPR 02,STF+=8
29900 JSA 16,IFIX
30000 JUMP 2
30100 ADDM .COMM.+=24
30200 ; 37000 C CENTERS THE NUMBER '1'
30300 MOVEM 11,RNUM# ;37100 CALL ALPHA
30400 JSA 16,ALPHA
30500 ; 37200 J3=J3X
30600 MOVE 02,J3X#
30700 MOVEM 02,.COMM.+=24
30800 ; 37300 IF(RB8.EQ.0)RETURN
30900 SKIPN RB8
31000 JRA 16,1(16)
31100 ; 37400 C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
31200 MOVE 3,.COMM.+=24 ;37500 R3=J3-R5
31300 TLC 3,232000
31310 FADR 3,3
31400 FSBR 3,.COMM.+6
31500 MOVEM 3,.COMM.+4
31600 SKIPE .COMM.+=31 ;37600 IF(J10.EQ.0)J10=1
31700 JRST .+3
31800 MOVEI 02,1
31900 MOVEM 02,.COMM.+=31 ;USE J10 FOR EVEN THICKER BOX AND CIRC.
32000 ; 37800 IF(RNUM.GT.9)R3=R3+R5*RBX
32050 MOVE 11,RNUM ;GET BACK RNUM (11 WIPED OUT WHEN PLOTTING)
32300 CAMG 11,[9.0]
32350 JRST .+4
32400 MOVSI 02,201400
32500 FMPR 02,.COMM.+6
32600 FADRM 02,.COMM.+4
32700 ; 37900 C TO SET CENTER IF(RB8.EQ.2)GO TO 5
32800 MOVSI 02,202400
32900 CAMN 02,RB8
33000 JRST MN5
33100 MOVE 02,[0.05] ;38100 R4=R4+R5+.1+.05/R5
33200 FDVR 02,.COMM.+6
33300 FADR 2,[0.1]
33400 FADR 02,.COMM.+6
33500 FADRM 02,.COMM.+5
33600 ; 38200 C END OF ABOVE IS FOR SMALL CIRCLES.
33700 MOVSI 02,203440 ;38300 B=4.5
33800 ;; MOVEM 02,B
33900 ; 38400 IF(RNUM.GE.100.)B=5.5
34000 CAML 11,[100.0]
34100 ;; CAMLE 02,11
34200 ;; JRST .+3
34300 MOVSI 02,203540
34400 ;; MOVEM 02,B
34500 ; 38500 R5=R5*B
34600 ;; MOVE 02,B
34700 FMPRM 02,.COMM.+6
34800 ; 38600 JA=12
34900 MOVEI 02,14
35000 MOVEM 02,.COMM.+1
35100 ; 38700 J6=0
35200 SETZM .COMM.+=27
35300 ; 38800 J7=0
35400 SETZM .COMM.+=28
35500 ; 38900 J8=J10
35600 MOVE 02,.COMM.+=31
35700 MOVEM 02,.COMM.+=29 ;39000 CALL CENTX
35800 JSA 16,CENTX
35900 JSA 16,SLUR ;39100 CALL SLUR
36000 JRA 16,1(16) ;39200 RETURN
36100 ; 39400 5 JA=4
36200 MN5: MOVEI 02,4
36300 MOVEM 02,.COMM.+1
36400 ; 39500 B=6
36500 MOVSI 02,203600
36600 ;; MOVEM 02,B
36700 ; 39600 R9=0
36800 SETZM .COMM.+=10
36900 ; 39700 IF(RNUM.LT.100.)GO TO 8
37100 CAMGE 11,[100.0]
37200 JRST MN8
37300 ; 39800 B=9.
37400 MOVSI 02,204440
37500 ;; MOVEM 02,B
37600 ; 39900 R9=R5*6.
37700 MOVSI 1,203600
37800 FMPR 1,.COMM.+6
37900 MOVEM 1,.COMM.+=10
38000 ; 40000 C MAKES RECTANGLE IF ↑100
38100 ; 40100 8 R4=R4+R5*.7+.1
38200 MN8: MOVE 03,[0.7]
38300 FMPR 03,.COMM.+6
38400 FADR 3,[0.1]
38500 FADRM 3,.COMM.+5
38600 ; 40200 R8=R5*B
38700 ;; MOVE 02,.COMM.+6
38800 ;; FMPR 02,B
38850 FMPR 2,.COMM.+6
38900 MOVEM 02,.COMM.+=9
39000 ; 40300 J5=50
39100 MOVEI 02,62
39200 MOVEM 02,.COMM.+=26
39300 ; 40400 CALL ITMSUB
39400 JSA 16,ITMSUB
39500 ; 40500 C RETURNS ORIG. HORIZ. POS.
39600 JRA 16,1(16) ;40600 END
39700 END